﻿Imports System.Reflection

Public Class frmDebug
    Inherits Form
    Friend WithEvents lblSupport As System.Windows.Forms.Label
    Friend WithEvents btnOk As System.Windows.Forms.Button
    Friend WithEvents rtfError As System.Windows.Forms.RichTextBox
    Friend WithEvents btnCopy As System.Windows.Forms.Button
    ''Public Property ParentControl As Control = Nothing

    Public Sub New()

        On Error Resume Next

        ' This call is required by the designer.
        InitializeComponent()

        ' Add any initialization after the InitializeComponent() call.
        rtfError.AppendText("Product Name:      " & My.Application.Info.ProductName & vbNewLine)
        rtfError.AppendText("Product Version:   " & My.Application.Info.Version.ToString() & vbNewLine)

        Dim asms As New List(Of Assembly)

        For Each asm As Assembly In My.Application.Info.LoadedAssemblies
            asms.Add(asm)
        Next asm

        'Assemblies are listed in the order they are loaded - I prefer them alphabetical.
        'But if the order in which assemblies are being loaded is important, then don't do the sort.
        Dim asmc As New AsmComparer()
        asms.Sort(asmc)

        rtfError.AppendText(vbNewLine)
        For Each asm As Assembly In asms
            'Many of the assemblies are core .Net assemblies. I do not care about them.
            'If you do, comemnt out this next line:
            ''If IO.Path.GetDirectoryName(asm.Location).ToUpper() <> My.Application.Info.DirectoryPath.ToUpper() Then Continue For

            'Included in this list is the executable path - which is meaningless.
            'Have to cast to Upper (or lower), because one of the paths returns as .EXE, and the other .exe
            If asm.Location.ToUpper() = Application.ExecutablePath.ToUpper() Then Continue For

            rtfError.AppendText("Loaded Assembly:   " & asm.ToString() & vbNewLine)
        Next asm

        rtfError.AppendText(vbNewLine)
        rtfError.AppendText("OS Name:           " & My.Computer.Info.OSFullName & vbNewLine)
        rtfError.AppendText("OS Version:        " & My.Computer.Info.OSVersion & vbNewLine)

        ''IMPORTANT: This next line is .Net 4.0 only.
        ''           If you need to know if it is a 64 bit OS or not, you will need to use
        ''           a different method for any .Net older than 4.0
        rtfError.AppendText("OS Platform:       " & IIf(Environment.Is64BitOperatingSystem, "x64", "x86") & vbNewLine)

        rtfError.AppendText("Physical Memory:   " & FormatBytes(My.Computer.Info.AvailablePhysicalMemory) & " / " & FormatBytes(My.Computer.Info.TotalPhysicalMemory) & " (Free / Total)" & vbNewLine)
        rtfError.AppendText("Virtual Memory:    " & FormatBytes(My.Computer.Info.AvailableVirtualMemory) & " / " & FormatBytes(My.Computer.Info.TotalVirtualMemory) & " (Free / Total)" & vbNewLine)

        rtfError.AppendText(vbNewLine)
        rtfError.AppendText("Error Output:" & vbNewLine)

    End Sub

    Private Function FormatBytes(ByVal bytes As Long) As String

        If bytes < 1000 Then
            Return CStr(bytes) & "B"
        ElseIf bytes < 1000000 Then
            Return FormatNumber(bytes / 1024, 2) & "KB"
        ElseIf bytes < 1000000000 Then
            Return FormatNumber(bytes / 1048576, 2) & "MB"
        Else
            Return FormatNumber(bytes / 1073741824, 2) & "GB"
        End If

    End Function

    Private Class AsmComparer
        Implements IComparer(Of Assembly)

        Public Function Compare(x As System.Reflection.Assembly, y As System.Reflection.Assembly) As Integer Implements System.Collections.Generic.IComparer(Of System.Reflection.Assembly).Compare
            Return String.Compare(x.ToString(), y.ToString())
        End Function
    End Class


    Private Sub btnCopy_Click(sender As System.Object, e As System.EventArgs) Handles btnCopy.Click

        My.Computer.Clipboard.Clear()
        My.Computer.Clipboard.SetText(rtfError.Text, TextDataFormat.Text)
        My.Computer.Clipboard.SetText(rtfError.Rtf, TextDataFormat.Rtf)

    End Sub

    Private Sub frmDebug_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        'OPTIONAL: This is just some basic code to dynamically size the output window based on the text.

        On Error Resume Next

        Dim longest As String = ""
        For Each line As String In rtfError.Lines
            If line.Length > longest.Length Then longest = line
        Next line

        Dim g As Graphics = rtfError.CreateGraphics()

    End Sub

    Private Sub InitializeComponent()
        Me.btnCopy = New System.Windows.Forms.Button()
        Me.rtfError = New System.Windows.Forms.RichTextBox()
        Me.btnOk = New System.Windows.Forms.Button()
        Me.lblSupport = New System.Windows.Forms.Label()
        Me.SuspendLayout()
        '
        'btnCopy
        '
        Me.btnCopy.Anchor = System.Windows.Forms.AnchorStyles.None
        Me.btnCopy.BackColor = System.Drawing.Color.Transparent
        Me.btnCopy.ForeColor = System.Drawing.Color.Black
        Me.btnCopy.Location = New System.Drawing.Point(195, 369)
        Me.btnCopy.Name = "btnCopy"
        Me.btnCopy.Size = New System.Drawing.Size(125, 32)
        Me.btnCopy.TabIndex = 7
        Me.btnCopy.Text = "Copy Text"
        Me.btnCopy.UseVisualStyleBackColor = False
        '
        'rtfError
        '
        Me.rtfError.Font = New System.Drawing.Font("Consolas", 12.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.rtfError.Location = New System.Drawing.Point(12, 23)
        Me.rtfError.Name = "rtfError"
        Me.rtfError.ReadOnly = True
        Me.rtfError.Size = New System.Drawing.Size(439, 342)
        Me.rtfError.TabIndex = 6
        Me.rtfError.Text = ""
        Me.rtfError.WordWrap = False
        '
        'btnOk
        '
        Me.btnOk.Anchor = System.Windows.Forms.AnchorStyles.None
        Me.btnOk.BackColor = System.Drawing.Color.Transparent
        Me.btnOk.DialogResult = System.Windows.Forms.DialogResult.OK
        Me.btnOk.ForeColor = System.Drawing.Color.Black
        Me.btnOk.Location = New System.Drawing.Point(326, 369)
        Me.btnOk.Name = "btnOk"
        Me.btnOk.Size = New System.Drawing.Size(125, 32)
        Me.btnOk.TabIndex = 5
        Me.btnOk.Text = "Ok"
        Me.btnOk.UseVisualStyleBackColor = False
        '
        'lblSupport
        '
        Me.lblSupport.AutoSize = True
        Me.lblSupport.Location = New System.Drawing.Point(10, 5)
        Me.lblSupport.Name = "lblSupport"
        Me.lblSupport.Size = New System.Drawing.Size(226, 13)
        Me.lblSupport.TabIndex = 4
        Me.lblSupport.Text = "Please provide support with a copy of this text:"
        '
        'frmDebug
        '
        Me.ClientSize = New System.Drawing.Size(457, 416)
        Me.Controls.Add(Me.btnCopy)
        Me.Controls.Add(Me.rtfError)
        Me.Controls.Add(Me.btnOk)
        Me.Controls.Add(Me.lblSupport)
        Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedToolWindow
        Me.MaximizeBox = False
        Me.MinimizeBox = False
        Me.Name = "frmDebug"
        Me.ShowIcon = False
        Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
        Me.Text = "Exception Debug"
        Me.ResumeLayout(False)
        Me.PerformLayout()

    End Sub
End Class